home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / cmln1085.arc / GSXFILL.INC < prev    next >
Text File  |  1986-02-27  |  5KB  |  118 lines
  1. { --- filled area functions.  Include as file GSXFILL.INC }
  2. {****************************************************************}
  3. procedure fillarea( npts : integer;  {in: no. of points on boundary
  4.                                           fill area}
  5.                    ptsin : pinteger  {in: pointer to points array
  6.                                           to be plotted and filled}
  7.                     );
  8. {****************************************************************}
  9.   var     contrl : array[1..5] of integer;
  10.           intin, intout, ptsout : integer;
  11.  
  12.   begin   contrl[1] :=  9;
  13.           contrl[2] :=  npts;
  14.           contrl[4] :=  0;
  15.           setpblock( addr(contrl), addr(intin ),
  16.                           ptsin  , addr(intout),
  17.                      addr(ptsout));
  18.           callgdos( addr(pb))
  19.   end;
  20.  
  21. {********************************************************************}
  22. procedure cellarray( intin : pinteger;    {in: ptr to color index array}
  23.                      rowlencolind,        {in: row length in cia}
  24.                      numeltcolind,        {in: element no. per row in cia}
  25.                      numrowscolind,       {in: no. of rows in cia}
  26.                      pixelop,             {in: pixel operation:
  27.                                                1  =  replace
  28.                                                2  =  overstrike
  29.                                                3  =  complement
  30.                                                4  =  erase}
  31.                      x1, y1,              {in: lower left coordinates}
  32.                      x2, y2 : integer);   {in: upper right coordinates}
  33. {********************************************************************}
  34.   {Draws rectangular array of cells using specified colors in color
  35.    index array.  Non supporting devices will outline rectangle in
  36.    current fill color}
  37.   var      contrl : array[1..9] of integer;
  38.            ptsin  : array[1..4] of integer;
  39.            intout, ptsout : integer;
  40.  
  41.   begin     contrl[1] :=  10;
  42.             contrl[2] :=   2;
  43.             contrl[4] :=   numeltcolind * numrowscolind;
  44.             contrl[6] := rowlencolind;
  45.             contrl[7] := numeltcolind;
  46.             contrl[8] := numrowscolind;
  47.             contrl[9] := pixelop;
  48.              ptsin[1] := x1;        ptsin[2] := y1;
  49.              ptsin[3] := x2;        ptsin[4] := y2;
  50.             setpblock( addr(contrl), intin,
  51.                        addr(ptsin ), addr(intout),
  52.                        addr(ptsout));
  53.             callgdos( addr(pb))
  54.   end;
  55.  
  56. {**********************************************************************}
  57. procedure setfillstyle( fstyle : integer { in: 0 = hollow    1 = solid
  58.                                                2 = pattern   3 = hatch }
  59.                        );
  60. {**********************************************************************}
  61.   var       contrl : array[1..5] of integer;
  62.             intin, intout, ptsin, ptsout : integer;
  63.  
  64.   begin      contrl[1] :=  23;
  65.              contrl[2] :=   0;
  66.              contrl[4] :=   1;
  67.                  intin := fstyle;
  68.              setpblock( addr(contrl), addr(intin ),
  69.                         addr(ptsin ), addr(intout),
  70.                         addr(ptsout));
  71.              callgdos( addr(pb))
  72.   end;
  73.  
  74. {****************************************************************************}
  75. procedure setfillpattern( patt:integer; {in: 1..6 = lightest to darkest dither
  76.                                                >6 = device dependent dither }
  77.                  var selected : integer {out: realized pattern}
  78.                 );
  79. {****************************************************************************}
  80.   var      contrl : array[1..5] of integer;
  81.            intin, intout, ptsin, ptsout : integer;
  82.  
  83.   begin      contrl[1] :=  24;
  84.              contrl[2] :=   0;
  85.              contrl[4] :=   1;
  86.              intin     := patt;
  87.              setpblock( addr(contrl), addr(intin ),
  88.                         addr(ptsin ), addr(intout),
  89.                         addr(ptsout));
  90.              callgdos( addr(pb));
  91.              selected := intout
  92.   end;
  93.  
  94. {******************************************************************}
  95. procedure setfillhatch( hatch : integer;
  96.   {in:       1 = vertical lines            2 = horizontal lines
  97.              3 = +45 degree lines          4 = -45 degree lines
  98.              5 = crosshatch (1 and 2)      6 = diamond hatch (3 and 4)
  99.             >6 = device dependent }
  100.  
  101.       var selected : integer     {out: realized hatch style}
  102.             );
  103. {********************************************************************}
  104.   var         contrl : array[1..5] of integer;
  105.               intin, intout, ptsin, ptsout : integer;
  106.  
  107.   begin      contrl[1] := 24;
  108.              contrl[2] :=  0;
  109.              contrl[4] :=  1;
  110.              intin     := hatch;
  111.              setpblock( addr(contrl), addr(intin ),
  112.                         addr(ptsin ), addr(intout),
  113.                         addr(ptsout));
  114.              callgdos( addr(pb));
  115.              selected := intout
  116.   end;
  117.  
  118.